macro 'export LUT        [E]';
{Copies the current look-up table to a text window.}
var
  i:integer;
  v:real;
  tab:string;
begin
  RequiresVersion(1.54);
  NewTextWindow('LUT',200,400);
  tab:=chr(9);
  for i:=0 to 255 do
    Writeln(i:4,tab,RedLut[i]:4,tab,GreenLut[i]:4,tab,BlueLut[i]:4);
end;

macro 'import text LUT [I]';
var
  i,r,g,b, width, height, start, row:integer;
  
begin

PutMessage('Imports LUT in the form of 3 column RGB text file (use Classic Mac CR!). If there are 4 columns, the first column is ignored.');
  SetImport('Text');
  Import('');
  GetPicSize(width,height);
  if width=3 then begin
    r:=0;
    g:=1;
    b:=2
  end else if width=4 then begin
      r:=1;
      g:=2;
      b:=3
  end else begin
    PutMessage('The text file must have either 3 or 4 columns.');
    exit;
  end;
  if height=255 then
    start:=1
  else if height=256 then
      start:=0
  else begin
      PutMessage('The text file must have either 255 or 256 rows.');
      exit;
   end;
  i:=start;
  row:=0;
  repeat
    RedLut[i]:=GetPixel(r,row);
    GreenLut[i]:=GetPixel(g,row);
    BlueLut[i]:=GetPixel(b,row);
    if (i mod 10) = 0 then UpdateLUT;
    i:=i+1;
    row:=row+1;
  until row>=height;
  UpdateLUT;
end;


macro 'plot LUT            [P]';
var
  i,xscale,yscale:real;
  width,height,margin,pwidth,pheight:integer;
  xbase,ybase:integer;
begin
  SaveState;
  margin:=25;
  pwidth:=400;
  pheight:=125;
  width:=pwidth+2*margin;
  height:=pheight*3+2*margin;
  SetNewSize(width,height);
  SetBackground(0); 
  MakeNewWindow('LUT');
  xscale:=(pwidth-2)/256;
  yscale:=(pheight-1)/256;
  SetForeground(252);
  xbase:=margin; ybase:=margin;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  SetForeground(253);
  ybase:=ybase+pheight-1;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  SetForeground(254);
  ybase:=ybase+pheight-1;
  MoveTo(xbase,ybase);
  for i:=0 to 255 do
    LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  SetForeground(255);
  MakeRoi(xbase,ybase,pwidth,pheight);
  FlipVertical;
  DrawBoundary;
  KillRoi;
  RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  UpdateLUT;
  SetFont('Geneva');
  SetFontSize(9);
  SetText('Centered');
  MoveTo(margin+4,height-margin+8);
  writeln(0:1:2);
  MoveTo(margin+pwidth,height-margin+8);
  writeln(255:1:2);
  RestoreState;
end;

macro '-';

macro 'reset LUT [Z]';
begin
  ResetGrayMap;
end;


macro '-';

macro 'invert LUT [X]';
var
  i:integer;
begin
  for i:=0 to 255 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  UpdateLUT;
end;


macro 'log transform';
var
  i,v:integer;
  scale:real;
begin
  scale := 255.0 / ln(255.0);
  for i:=1 to 254 DO begin
    v := 255-round(ln(i) * scale);
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
end;


macro 'gamma transform ';
var
  i,v:integer;
  n,mode,min,max:integer
  gamma,mean:real;
begin
  gamma:=GetNumber('Gamma(0.1-3.0):',2);
  measure;
  GetResults(n,mean,mode,min,max);
  ShowMessage('min=',min:1,'\max=',max:1);
  for i:=1 to 254 DO begin
    if (i>min) and (i<max)
      then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
      else begin
        if i<=min then v:=0 else v:=255;
      end;
    RedLUT[i]:=255-v;
    GreenLUT[i]:=255-v;
    BlueLUT[i]:=255-v;
  end;
  UpdateLUT;
end;


macro 'square transform';
var
  i,v:integer;
  sqr255:real;
BEGIN
  sqr255:=sqr(255.0);
  for i:=1 to 255 DO begin
    v:=round(sqr(i)*255.0/sqr255);
    RedLUT[255-i]:=v;
    GreenLUT[255-i]:=v;
    BlueLUT[255-i]:=v;
  end;
  UpdateLUT;
END.

macro 'parabolic transform';
{ Generates a parabolic LUT}
var
  i,y:integer;
  scale:real;
begin
  scale:=1;
  for i:= 1 to 254 do begin
    y:= (i-127)*(i-127)*scale/64.25;
    if y > 255 then y:=255;
    RedLUT[i]:=y;
    GreenLUT[i]:= y;
    BlueLUT[i]:=y;
  end;
  UpdateLUT;
end;

macro 'square root transform';
var
  i,v:integer;
  sqrt255:real;
BEGIN
  sqrt255:=sqrt(255.0);
  for i:=1 to 255 DO begin
    v:=round(sqrt(i)*255.0/sqrt255);
    RedLUT[255-i]:=v;
    GreenLUT[255-i]:=v;
    BlueLUT[255-i]:=v;
  end;
  UpdateLUT;
END;

macro '-';

macro 'make steps [T]';

VAR
  delta,steps,StepSize,NextStep:real;
  level,i:integer;

BEGIN

  steps := GetNumber('number of steps', 10);

  StepSize:=256/steps;
  delta:=256/(steps-1);
  NextStep:=trunc(StepSize);
  level:=255;

  for i:=0 to 255 do begin
    if i>=NextStep then begin
      NextStep:=trunc(NextStep+StepSize);
      level:=level-delta;
      UpdateLUT;
    end;
    if level<0 then level:=0;
    RedLUT[i]:=level;
    GreenLUT[i]:=level;
    BlueLUT[i]:=level;
  end;

end;

macro 'sawtooth    [S]';

VAR
  delta,steps,StepSize,NextStep:real;
  level,i,sigbit,sloplen,nslopes,grayinc:integer;
  j,istart,iend:integer;

BEGIN

  sigbit := GetNumber('number of significant bits (1-8)', 4);
  if sigbit = 8 then sloplen:=256;
  if sigbit = 7 then sloplen:=128;
  if sigbit = 6 then sloplen:=64;
  if sigbit = 5 then sloplen:=32;
  if sigbit = 4 then sloplen:=16;
  if sigbit = 3 then sloplen:=8;
  if sigbit = 2 then sloplen:=4;
  if sigbit = 1 then sloplen:=2;

  nslopes:=256/sloplen;
  grayinc:=256/sloplen;

  for j:= 1 to nslopes do begin
    istart:= (j-1)*sloplen;
    for i:=1 to sloplen do begin     
    level:=255-((i-1)*grayinc);
    RedLUT[i+istart-1]:=level;
    GreenLUT[i+istart-1]:=level;
    BlueLUT[i+istart-1]:=level;
    end;
  end;

UpdateLUT;
 
end;


macro '-';

macro 'red LUT             [R]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=RedLUT[i];
    GreenLUT[i]:=0;
    BlueLUT[i]:=0;
  end;
  UpdateLUT;
end;

macro 'green LUT         [G]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=0;
    GreenLUT[i]:=GreenLut[i];
    BlueLUT[i]:=0;
  end;
  UpdateLUT;
end;

macro 'blue LUT           [B]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=0;
    GreenLUT[i]:=0;
    BlueLUT[i]:=BlueLut[i];
  end;
  UpdateLUT;
end;

macro 'red-green CIE   [1]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=RedLUT[i];
    GreenLUT[i]:=255-GreenLUT[i];
    BlueLUT[i]:=200-(BlueLut[i]/2);
  end;
  UpdateLUT;
end;

macro 'blue-yellow CIE [2]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=90+(RedLUT[i]/2);
    GreenLUT[i]:=90+(GreenLUT[i]/2);
    BlueLUT[i]:=255-BlueLut[i];
  end;
  UpdateLUT;
end;


macro '-';



macro 'color LUT for 3 phases [3]';
var
  i,j,l,k,min,max,mode:integer;
  x,y,w,h,n,mean : integer;
begin
 ShowHistogram;
 PutMessage('lower limit 1 is zero, determine 3 upper limits before you start');
 i:= GetNumber('upper limit 1: ',30);
 l:= GetNumber('upper limit 2: ',60);
 k:= GetNumber('upper limit 3: ',90);
  for j:=0 to i do begin
     RedLUT[j]:=255;
    GreenLUT[j]:=255;
    BlueLUT[j]:=220;
  end;
  for j:=i+1 to l do begin
    RedLUT[j]:=255;
    GreenLUT[j]:=255;
    BlueLUT[j]:=0;
  end;
   for j:=l+1 to k do begin
    RedLUT[j]:=255;
    GreenLUT[j]:=0;
    BlueLUT[j]:=0;
  end;
 UpdateLUT;
end;

macro 'color LUT for 2 phases [4]';
var
  i,ii,iii,iv,j,l,k,min,max,mode:integer;
  x,y,w,h,n,mean : integer;
begin
 ShowHistogram;
 PutMessage('determine 2 lower and upper limits before you start');
 i:= GetNumber('lower limit 1: ',40);
 ii:= GetNumber('upper limit 1: ',80);
 iii:= GetNumber('lower limit 2: ',120);
 iv:= GetNumber('upper limit 2: ',160);
   for j:=i to ii do begin
    RedLUT[j]:=255;
    GreenLUT[j]:=255;
    BlueLUT[j]:=0;
  end;
  for j:= iii to iv do begin
    RedLUT[j]:=200;
    GreenLUT[j]:=200; 
    BlueLUT[j]:=0;
  end;
 UpdateLUT;
end;


macro 'color LUT for 6 phases [5]';
var
  i,ii,iii,iv,v,vi,j,l,k,min,max,mode,gv:integer;
  x,y,w,h,n,mean : integer;
begin
 ShowHistogram;
 PutMessage('lower limit 1 is zero, determine 6 upper limits before you start, from upper limit 6 to 255 will be inverted');
 i:= GetNumber('upper limit 1: ',30);
 ii:= GetNumber('upper limit 2: ',80);
 iii:= GetNumber('upper limit 3: ',107);
 iv:= GetNumber('upper limit 4: ',162);
 v:= GetNumber('upper limit 5: ',200);
 vi:= GetNumber('upper limit 6: ',220);

  for j:=0 to i do begin
    RedLUT[j]:=255;
    GreenLUT[j]:=100;
    BlueLUT[j]:=0;
  end;
  for j:= i+1 to ii do begin
    RedLUT[j]:=255;
    GreenLUT[j]:=255;
    BlueLUT[j]:=0;
  end;
  for j:= ii+1 to iii do begin
    RedLUT[j]:=0;
    GreenLUT[j]:=255;
    BlueLUT[j]:=0;
  end;
  for j:= iii+1 to iv do begin
    RedLUT[j]:=0;
    GreenLUT[j]:=255;
    BlueLUT[j]:=255;
  end;
  for j:= iv+1 to v do begin
    RedLUT[j]:=0;
    GreenLUT[j]:=0;
    BlueLUT[j]:=255;
  end;
  for j:= v+1 to vi do begin
    RedLUT[j]:=0;
    GreenLUT[j]:=0;
    BlueLUT[j]:=20;
  end;
  for j:= vi+1 to 255 do begin
    RedLUT[j]:=255-RedLUT[j];
    GreenLUT[j]:=255-RedLUT[j];
    BlueLUT[j]:=255-RedLUT[j];
  end;
 UpdateLUT;
end;


macro 'gray LUT for 6 phases  [6]';
var
  i,ii,iii,iv,v,vi,j,l,k,min,max,mode,gv:integer;
  x,y,w,h,n,mean : integer;
begin
 ShowHistogram;
 PutMessage('lower limit 1 is zero, determine 5 upper limits before you start, upper limit 6 is 255');
 i:= GetNumber('upper limit 1: ',30);
 ii:= GetNumber('upper limit 2: ',80);
 iii:= GetNumber('upper limit 3: ',107);
 iv:= GetNumber('upper limit 4: ',162);
 v:= GetNumber('upper limit 5: ',200);
 vi:= 255;

  for j:=0 to i do begin
    gv:=i/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
  for j:= i+1 to ii do begin
    gv:=(i+ii)/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
  for j:= ii+1 to iii do begin
    gv:=(ii+iii)/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
  for j:= iii+1 to iv do begin
    gv:=(iii+iv)/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
  for j:= iv+1 to v do begin
    gv:=(iv+v)/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
  for j:= v+1 to vi do begin
    gv:=(v+vi)/2;
    RedLUT[j]:=255-gv;
    GreenLUT[j]:=255-gv;
    BlueLUT[j]:=255-gv;
  end;
 UpdateLUT;
end;
